home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SORTING.SWG / 0025_SOMESORT.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  2KB  |  112 lines
  1. { Author: Brian Pape. }
  2.  
  3. Const
  4.   maxrange = 5000;
  5.  
  6. Type
  7.   ListRange = 1..MaxRange;
  8.   list = Array[ListRange] of Integer;
  9.  
  10. Var
  11.   a,b: list;
  12.   i: Integer;
  13.  
  14. Procedure BubbleSort(Var B : list; Terms : Integer);
  15. Var
  16.   J, Temp : Integer;
  17.   Changed : Boolean;
  18.   Last,
  19.   LastSwitch : Integer;
  20. begin
  21.   changed := True;
  22.   Last := Terms-1;
  23.   While Changed do
  24.   begin
  25.     changed := False;
  26.     For J := 1 to Last do
  27.       If B[J] > B[J+1] then
  28.       begin
  29.         Temp := B[J];
  30.         B[J] := B[J+1];
  31.         B[J+1] := Temp;
  32.         Changed := True;
  33.         LastSwitch := j;
  34.       end;  { If B[J] }
  35.     Last := LastSwitch -1;
  36.   end  { While Changed }
  37. end;  { BubbleSort }
  38.  
  39. Procedure Min_MaxSort(Var a : list;  NumberTerms : ListRange);
  40. Var
  41.   temp,
  42.   i,l,r,
  43.   min,max,
  44.   tempMin,
  45.   tempMax,
  46.   indexMin,
  47.   indexMax,
  48.   s1,s2,s3,s4 : Integer;
  49.   changed     : Boolean;
  50. begin
  51.   l := 1;  r := NumberTerms;  max := MaxInt;
  52.   Repeat
  53.     min := max;
  54.     changed := False;
  55.     max := 0;
  56.     For i := l to r do
  57.     begin
  58.       if a[i] > max then
  59.       begin
  60.         changed := True;
  61.         Max := a[i];
  62.         indexMax := i;
  63.       end;  { if }
  64.       if a[i] < min then
  65.       begin
  66.         changed := True;
  67.         Min := a[i];
  68.         indexMin := i;
  69.       end;  { if }
  70.     end;  { For }
  71.  
  72.     tempMin := a[indexMin];
  73.     tempMax := a[indexMax];
  74.     a[indexMax] := a[l];
  75.     a[l] := tempMin;
  76.     a[indexMin] := a[r];
  77.     a[r] := tempMax;
  78.     inc(l);  dec(r);
  79.   Until (l>=r) or not changed;
  80. end;  { Min_MaxSort }
  81.  
  82.  
  83. Procedure ShellSort(Var a : list;  NumberTerms : ListRange);
  84. Const
  85.   start = 1;
  86.   increment = 3;  { division factor of terms }
  87. Var
  88.   i,j   : ListRange;
  89.   t     : Integer;
  90.   found : Boolean;
  91. begin
  92.   i := start + increment;
  93.   While i <= NumberTerms do
  94.   begin
  95.     if a[i] < a[i - increment] then
  96.     begin
  97.       j := 1;
  98.       t := a[i];
  99.       Repeat
  100.         j := j - increment;
  101.         a[j + increment] := a[j];
  102.         if j = 1 then
  103.           found := True
  104.         else
  105.           found := a[j - increment] <= t;
  106.       Until found;
  107.       a[j] := t;
  108.     end;  { if }
  109.     i := i + increment;
  110.   end;  { While }
  111. end;  { ShellSort }
  112.